perm filename ITMSUB.OLD[XX,LCS] blob sn#195543 filedate 1976-01-19 generic text, type T, neo UTF8
00100	C**** ITMSUB, BMS, METER, RNOTE, MAKNUM, IABS, DRWNT, RHORZ, RDRAW
00200	C  ********** WHOLE & HALF RESTS, BEAMS ******
00300		SUBROUTINE ITMSUB
00400		IMPLICIT INTEGER(A-Q,S-Z)
00500		REAL DIS,DISX,HGT,POS,CENTR,STFF,HGT1
00600		COMMON/STF/RSTFAC(-3/4),RSTJ2/MIN/MINI,RMINI
00700		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/BM/RA,RC,RJY
00800		COMMON/POSI/STFF(-3/4),JJ2,POS/PLTR/PLT,RHT,DIS
00900		COMMON/ALF/QQ(3),RST7,RST18,R3Q,JY,RD,RX,RW,RJX,RJ,L,K,
01000		1 RJA,YY,DISX,HGT,RZ,INP(53)
01100		COMMON/DAT/RACNT(65),RDOT(17),XAC(7),RNOTE(22),RACCI(22),NACCI(3)
01200		EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3))
01300		1,(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8))
01400		1,(J11,JQ(9)),(J6,JQ(4)),(R9,RJQ(7)),(R8,RJQ(6)),(R3,RJQ(1))
01500		1 ,(R7,RJQ(5)),(R4,RJQ(2)),(R9,RJQ(7)),(R10,RJQ(8)),(RX3,RJQ(20))
01600		DATA R14/14.54/,RTF/3.0/,RHGT/48.0/,R2HGT/96.0/,RBM/.83/
01700		1,RDBR/ 3.5/,RBR/.33/,RBX/ 7.0/
01800	C  RDBR IS SPACER FOR DBL BAR.
01900	C  RTF COMPENSATES FOR BAD PLANNING.
02000		RST7=RSTJ2*7.
02100		RST18=RSTJ2*18.
02200	C  TO COMPENSATE FOR NOTE #3 COMING AT POS=0
02300	
02400		R3Q=R3
02500	CC???	JY=0
02600		IF(JA.EQ.6)GO TO 90
02700		IF(JA.EQ.8)GO TO 100
02800	C  GO TO LINES, BEAMS, STAVES.
02900	C   NEXT DRAWS STRAIGHT LINES
03000	
03100		RD=R4*RST7
03200		RA=0
03300		RX=RTF*RSTJ2+POS
03400	C  SOMEDAY ADD < RDIS=1./DIS >  TO REPLACE ALL 1./DIS'S
03500		IF(J5.EQ.50)GO TO 300
03600	C  50 IS FOR CRESC., DECRESC. AND BOXES
03700		IF(R6.NE.0)GO TO 401
03800		IF(J7.NE.0)GO TO 401
03900	C  FOR BAR LINES
04000	4000	JA=44
04100	C  CODE # IS CHNGD SO BAR LINES WON'T AFFECT MAX. HGT.
04200	C ↑↑↑↑↑↑↑↑↑ FOR VERTICAL WIGGLE (P6=0, P7=-1)
04300		DBR=0 
04400		IF(J4.LT.1000)GO TO 400
04500	C  J4=1001 = DBL BAR,  =1401 = DBL BAR WITH RT. ONE HEAVY: J5=1=DOTS ADDED
04600	CK	J4=J4-1000
04700	CK	DBR=-1
04800	CK400	J7=(J4/100)*DIS
04900		DBR=J4/1000
05000		J4=J4-DBR*1000
05100	C DBR=1 HEAVY BAR IS ON RT.  =2 ON LEFT.  =3 IN MIDDLE.
05200	9400	RD=RDBR+RDBR*RSTJ2
05300	C  TO SPACE THIN BAR FROM HEAVY
05400		IF(J5.EQ.0)GO TO 400
05500	C  NEXT ADDS REPEAT DOTS TO DBL BAR.
05600		L=J4
05700		RJ=L/100
05800		IF(RJ.EQ.0)RJ=6.*RSTJ2
05900	C HEAVY BAR WILL BE 5 LINES WIDE.
05910		RZ=R3
06000		J4=0
06100	C  MUST BE 0 FOR DOTS IN 'NOTWRT'
06200		IF(DBR.EQ.0)DBR=J5
06300		J5=0
06400	C J5=1 RPT ←, =2 RPT →, =3 RPT ↔
06500		RJA=RD*2.
06600	C  TO SPACE DOTS, NOT ACCURATE FOR VERY SMALL OR VERY LARGE SIZE FACTORS
06700		JY=DBR
06800		IF(DBR.LT.2)GO TO 8400
06900		R3=RJA+RJ+RZ
07000	7400	DO 3400 K=J2,MOD(L,100)+J2-1
07100		RSTJ2=RSTFAC(K)
07200		POS=STFF(K)
07300		R4=6
07400		CALL CENTX
07500	C  SPACES DOTS OUT FROM BAR
07600		CALL RDRAW(1,17.0,RDOT,RSTJ2,R3,CENTR+RSTJ2,RSTJ2)
07700	C  GO GET THE DOT
07800		R4=8
07900		CALL CENTX
08000	3400	CALL RDRAW(1,17.0,RDOT,RSTJ2,R3,CENTR+RSTJ2,RSTJ2)
08100		JY=JY-1
08200		IF(JY.LT.2)GO TO 4400
08300	8400	R3=RZ-RJA-4.*RSTJ2
08400		GO TO 7400
08500	C  DO I NEED ANY MORE RESETS????
08600	4400	J4=L
08610		J7=RJ*DIS
08620		GO TO 5400
08700	400	IF(J5.NE.0)GO TO 9400
08800		K=J4/100
08900	C  K IS FOR SPACING OF THIN BAR IN HEAVY-THIN ORDER
09000		J7=K*DIS
09100	C  J7=NUM OF STROKES -- BASED ON FINAL SIZE FACTOR (DIS)
09200	5400	L=MOD(J4,100)
09300		IF(L.EQ.0)L=1
09400		L=L+J2-1
09500	C J4=401 MAKES 4X THICK BARLINE - ONE STAFF
09600		RA=RTF
09700		IF(L.LE.4)GO TO 2400
09800		L=4
09900		RA=300.
10000	C FOR EXTENDING BARS ABOVE STAFF 4
10100	2400	RY=RSTFAC(L)
10110		RZ=R3Q
10155	C  SAVE IT FOR DBL RPT BAR.
10200		RY=STFF(L)+(RA+56.)*RY
10300	1400	RA=1
10400		IF(PLT.GE.0)GO TO 140
10500		J7=J7+1
10600		RA=1./DIS
10700	C  BAR LINES PLOT AS DOUBLE THICKNESS
10800	140	RJX=R3Q
10900	42	CALL LINES(R3Q,RX,3)
11000		RJ=-1.
11100		RW=RY
11200	406	CALL LINES(RJX,RY,2)
11300		IF(J10.EQ.0)GO TO 411
11400	C  P10 WILL THICKEN VERTICAL (OR MOSTLY VERTICAL) LINES.
11500		J7=J10*DIS
11600		J10=0
11700		RA=1./DIS
11800	411	IF(J7.GT.0)GO TO 409
11900		IF(DBR.LE.0)RETURN
12000		RY=RW
12100	CK	R3Q=R3Q-RDBR
12200		RA=RZ-RD
12300		IF(DBR.NE.1)RA=RJX+RD-1.
12400		DBR=DBR-2
12500		R3Q=RA
12600		GO TO 1400
12700	CC411	IF(J7.LE.0)RETURN
12800	C  FOR 'HEAVY' LINE.
12900	409	RJX=RJX+RA
13000		CALL LINES(RJX,RY,2)
13100		J7=J7-1
13200		RY=RW
13300		IF(RJ)RY=RX
13400		RJ=-RJ
13500		GO TO 406
13600	CC43	IF(RA.LE.0)RETURN
13700	C   HOW IS RA.NE.0?
13800	C  DRAWS BAR LINES. J4>0 CAUSES FULL LINE.
13900	CC403	RA=RA-3.72
14000	CC	R3Q=R3Q+22
14100	CC	RJX=RJX+22
14200	C   DO ABOVE NEED *RSTJ2? ************
14300	C **** BASED ON '596' ****
14400	CC	GO TO 42
14500	
14600	C  FOR CRESC., DECRESC.
14700	300	IF(R7.EQ.0)R7=2.3
14800		IF(R7.EQ.-1.)R7=-2.3
14900		RA=ABS(R7/2.0)*RST7
15000	C   AMOUNT OF SPREAD
15100		RJ=R3Q
15200		RX=RX-RST18+RD
15300		IF(R8.NE.0)GO TO 302
15400	C  JUMP TO MAKE BOX
15500		R6=RHORZ(R6)
15600		IF(R7)GO TO 301
15700		RJ=R6
15800		R6=R3Q
15900	301	CALL LINX(RJ,RX+RA,R6,RX)
16000		CALL LINES(RJ,RX-RA,2)
16100	C FOR CRESC, DECRESC:4 POS1, STF, HGT, 50, POS1, +OR-N(0=2.3,-1=-2.3)
16200	CC	IF(PLT.NE.-2)RETURN
16300		IF(PLT.GE.0)RETURN
16400	C  THIS MAKES ALL CRESC. DBL THICKNESS AT PRINT TIME.
16500		IF(J8)RETURN
16600		RX=RX+1./DIS
16700		J8=-1
16800	C FOR DOUBLE THICKNESS
16900		GO TO 301
17000	
17100	302	R8=R8*RST7
17200		R9=R9*RST7
17300		IF(R9.EQ.0)R9=R8
17400	C  R9=0 MAKES SQUARE    
17500		R3=R3Q-R8/2.
17600		RX=RX-R9/2.
17700		J10=J10*DIS
17800	C  DRAWS BOX, CENTER IS IN MIDDLE 
17900	C  4,POS,STF,NT#,50,0,0,,SIZ1[BY NT#S],SIZ2
18000	1302	CALL LINX(R3,RX,R3+R8,RX)
18100		CALL LINES(R3+R8,RX+R9,2)
18200		CALL LINES(R3,RX+R9,2)
18300		CALL LINES(R3,RX,2)
18400		IF(J10.EQ.0)RETURN
18500		J10=J10-1
18600		RJ=1./DIS
18700		R3=R3-RJ
18800		R8=R8+RJ+RJ
18900		RX=RX-RJ
19000		R9=R9+RJ+RJ
19100		GO TO 1302
19200	C  TO THICKEN BOXES.
19300	
19400	1401	R4=2.0
19500	C FOR HEAVY BRACK.
19600		RA=RSTJ2*RBX
19700		RX=RX-RA
19800	C  THE BOTTOM
19900		L=J4+J2-1
20000		R6=RTF
20100		IF(L.LE.4)GO TO 4401
20200		L=4
20300		R6=300.
20400	4401	RA=STFF(L)
20500	C SAVE FOR POS. OF BRACK. END ON UPPER STAFF.
20600		RJY=RSTFAC(L)
20700		RY=RA+R6*RJY+RJY*56.+RJY*RBX
20800	C  THE TOP
20900		R5=9.5
21000		GO TO 2401
21100	
21200	C  DASHES
21300	401	POS=POS-RST18
21400	C********* 27/9/72 ******
21500		IF(J7.LE.0)GO TO 407
21600		IF(J7.EQ.4)GO TO 1401
21700		IF(J7.NE.3)GO TO 4001
21800	C  NEXT IS FOR VARIABLE LARGE BRACKET. P7=3 P10=THICK. P5=HGT P6=P3
21900	2401	JA=3
22000		IF(J10.EQ.0)J10=5
22100	C  DEFAULT VALUE FOR THICKNESS =5
22200		R4=R4-RBR
22300		J9=0
22400		J5=35
22500	C  THE NUM FOR THE LITTLE END ITEMS
22600	CC	RY=R6-2.1*RSTJ2
22700		R6=3 
22800		R7=0
22900	C DOES LOWER ONE FIRST.  ITEM IS IN 'CLEF3.DMD' ON DAT.LCS
23000		IF(J8.NE.2)CALL CLEFS
23100	C P8=1=BOTTOM 1/2 BRACK. ONLY:  =2=TOP 1/2 ONLY:  0=COMPLETE
23200		R4=R5-RBR
23300		R6=3
23400		R7=-3
23500	C  TURNS IT UPSIDE DOWN.
23600	CC	JA=3
23700		IF(J7.NE.4)GO TO 3401
23800		POS=RA
23900		R4=R4*RJY/RSTJ2
24000	C  TO ADJUST HEIGHT OF BRACK END WHEN STAVES ARE DIFF. SIZES.
24100	3401	IF(J8.NE.1)CALL CLEFS
24200		R3Q=R3Q-12.0*RSTJ2
24300		IF(J7.NE.4)GO TO 407
24400		J7=0
24500		GO TO 140
24600	
24700	4002	J5=4
24800	C FOR CURVY BRACKET.  P6 CAN CHANGE WIDTH.
24900		R8=0
25000		J4=J4+J2-1
25100		R7=(.3136*RSTFAC(J4)+.0056*(STFF(J4)-STFF(J2)))/RSTJ2
25200	C  .0056=.0392/7.(THE MAGIC NUM FOR VERT SIZE OF BRACK.) .3136=8*.0392
25300	C  ADD DIST BETWEEN BOTTOM OF STAVES TO HEIGHT OF TOP STAFF
25400		IF(R6.EQ.0)R6=1.+R7/20.
25500		JA=3
25600		R4=2.3
25700	C  C  BECAUSE BRACK DOESN'T REALLY GO UP FROM 0 ?!?X*⊗
25800		CALL CLEFS
25900		RETURN
26000	
26100	4001	IF(J7.EQ.5)GO TO 4002
26200		IF(R8.EQ.0)R8=.8
26300	C  P8 CAN SET SIZE OF DASH
26400		RD=RD+POS
26500		IF(J7.EQ.1)GO TO 402
26600	C  =1 =VERTICAL DASHES
26700		RA=RHORZ(R6)
26800		RST7=5.96*RSTJ2
26900		RJX=R3Q
27000		GO TO 420
27100	402	RA=POS+R5*RST7
27200		RJY=RD
27300	C  SAVE FOR THICK LINES
27400	420	RJ=R8*RST7
27500	41	L=3
27600		K=2
27700	416	CALL LINES(R3Q,RD,L)
27800		IF(J7.EQ.1)GO TO 412
27900	C  JUMP FOR VERTICAL DASH
28000		IF(R3Q.GE.RA)GO TO 413
28100	C  JUMP IF ALL DONE
28200		R3Q=R3Q+RJ
28300	414	CALL EXCH(L,K)
28400		GO TO 416
28500	412	IF(RD.GE.RA)GO TO 413
28600	C  JUMP IF DONE
28700		RD=RD+RJ
28800		GO TO 414
28900	413	IF(J10.LE.0)RETURN
29000	C  NEXT FOR THICK DASHES
29100		J10=J10-1
29200		IF(J7.EQ.1)GO TO 415
29300		R3Q=RJX
29400		RD=RD+1./DIS
29500		GO TO 41
29600	415	R3Q=R3Q+1./DIS
29700		RD=RJY
29800		GO TO 41
29900	
30000	
30100	407	RX=RD+POS
30200		RY=R5*RST7+POS
30300		IF(J7.EQ.3)GO TO 140
30400		CALL NOZERO(R9)
30500		IF(J7.EQ.-1)GO TO 408
30600	C  FOR 'TR' J7=-2, 'ARPEGG' J7=-1,  STRAIGHT LINES J7=0
30700	CC  WHY THE IFIX????	RJX=IFIX(RHORZ(R6))
30800		RJX=IFIX(ROFF(RHORZ(R6)))
30900	C  ALL THIS CRAP SO IT WILL MATCH UP WITH P3 WHEN NECESSARY.
31000		IF(J7.EQ.0)GO TO 42
31100		RY=R9*RST7+RX
31200		CALL NOZERO(R8)
31300	4041	RZ=RX
31400		RH=RY
31500	C  SAVE FOR THICK WIGGLES
31600		CALL LINES(R3Q,RX,3)
31700	C  DRAWS STRAIGHT LINES. ETC.
31800		R9=R3Q
31900		RJ=RY
32000		RW=3.*RSTJ2*R8
32100		RA=RW*2.5
32200	C  P8=HORZ. WIGGLE SIZE;  P9=VERT. SIZE
32300	404	R9=R9+RA
32400		CALL LINES(R9,RJ,2)
32500		R9=R9+RW
32600		CALL LINES(R9,RJ,2)
32700	405	CALL EXCH(RX,RJ)
32800		IF(R9.LT.RJX)GO TO 404
32900		IF(J10.LE.0)RETURN
33000		RX=RZ+1./DIS
33100		RY=RH+1./DIS
33200		J10=J10-1
33300		GO TO 4041
33400	C  P10= + NUM OF THICKNESSES TO WIGGLE
33500	
33600	408	IF(RX.GT.RY)CALL EXCH(RX,RY)
33700		RZ=R9*RSTJ2*5.96
33800	C  USE P9 TO SET WIGGLE WIDTH.  P8 TO SET HGT.
33900		CALL NOZERO(R8)
34000		RD=R8*RST7*.5
34100		RJ=RD
34200		IF(RD.LT.1.)RD=1.
34300	421	R9=RX
34400		RW=R3Q
34500		RA=RZ+R3Q
34600		CALL LINES(RW,R9,3)
34700	410	R9=R9+RJ
34800		CALL LINES(RA,R9,2)
34900		R9=R9+RD
35000		CALL LINES(RA,R9,2)
35100		CALL EXCH(RA,RW)
35200		IF(R9.LT.RY)GO TO 410
35300		IF(J10.LE.0)RETURN
35400		R3Q=R3Q+1./DIS
35500		J10=J10-1
35600		GO TO 421
35700	C  VERTICAL WIGGLE   P10=+ NUM OF THICKNESSES.
35800	
37900	
38200	C  NEXT IS FOR BEAMS
38300	90	RMINI=RSTJ2
38400		RX=2.7*RSTJ2*5.96
38500	C******************************
38600		R6=RHORZ(R6)
38700		IF(R8.NE.0)GO TO 204
38800		IF(R10.GE.10)GO TO 204
38900		IF(J7)GO TO 204
39000		IF(R9.NE.0)GO TO 1
39100	C  R8=0 AND R9=NUM  -- PUTS NUMBER OUTSIDE BEAM(FOR TRIPLETS, ETC.)
39200	204	IF(R9.NE.0)R9=RHORZ(R9)
39300		IF(J7)GO TO 201
39400	200	IF(J10.LT.10)GO TO 91
39500	C NEXT FOR INNER, PARTIAL BEAMS
39600		R8=RHORZ(R8)
39700		R10=AMOD(R10,10.)
39800		GO TO(2,3,4),J10/10
39900	2	RH=R9+RX
40000		GO TO 1
40100	3	R8=R9-RX
40200	C 10=SHORT PARTIAL LFT→RT., 20=RT.←LFT, 30=TO POS IN P8
40300	4	RH=R8
40400	C  LEFT INNER POS.
40500		GO TO 1
40600	201	J7=-J7
40700	C P8=WIDTH OF TREM. P9=0(SANS OTHER BEAMS) OR =POS.3, P10=DISP.
40800		CALL NOZERO(R10)
40900	C  ALWAYS AT LEAST 1 IN DISPLACEMENT
41000		J10=30
41100	C TO ACTIVATE PARTIAL BEAM SECTION
41200		IF(J9.NE.0)GO TO 202
41300	C  NEXT FOR TREM. WITHOUT OTHER BEAMS.
41400		RH=-1
41500		IF(J7.GE.20)RH=-RH
41600	CC203	R4=R4+R10*RH
41700	CC	CALL CENTX
41800		R5=R4+RH
41900		R9=R3
42000		R6=R3+22.*RMINI
42100	202	IF(R8.EQ.0)R8=4. 
42200		RX=R8*RMINI*2.98
42300		RH=R9+RX
42400		R9=R9-RX
42500		GO TO 1
42600	
42700	91	IF(J8.EQ.0)GO TO 1
42800		IF(J8.GT.0)GO TO 92
42900	C FOR J8=-(10+DN) OR -(20+DN)
43000		R9=R3+RX
43100		IF(J8.LE.-20)R9=R6-RX
43200	192	J8=-J8
43300	92	IF(J10.EQ.0)J10=MOD(J8,10)
43400	CC??? 4/75	J8=J8-J10
43500		IF(J10.EQ.0)J10=1
43600		R10=J10
43700	C IF P8 NEG, P9 IS AUTOMATIC, ALSO P10 IF NEEDED.
43800	1	IF(IABS(J4).LT.100)GO TO 97
43900		RMINI=.6*RSTJ2
44000		R5=AMOD(R5,100.0)
44100	C   SPACE BETWEEN BEAMS
44200	97	RJ=RMINI*11.
44300		RW=RMINI*RHGT
44400	C  DIST. UP OR DOWN FROM NOTE HEAD.
44500		RJA=R10*RJ
44600	C  DISPLACEMENT
44700		RD=R9
44800	C  POSITION 3
44900		RJX=CENTR-RW+RJA
45000	C  FINAL HEIGHT OF LEFT SIDE
45100	C  NEG R7=TREMOLO
45200		RX=MOD(J7,10)
45300		JJ2=J7-20
45400		RA=R6
45500	C  HORIZANTAL DIST.
45600		RJY=R5*RST7+POS-RST18-RW+RJA
45700	C   VERTICAL POS OF RIGHT SIDE.
45800		RW=R14*RMINI
45900		RY=1.
46000		IF(J7.GE.20)GO TO 98 
46100	C JUMP IF STEMS ARE DOWN
46200		RY=-RY
46300	C  FOR  THICKENING INCR.
46400		JJ2=J7-10
46500		RJ=-RJ
46600		RJA=RMINI*R2HGT-2.*RJA
46700		RJX=RJX+RJA
46800		RJY=RJY+RJA
46900		R3Q=R3Q+RW
47000	C  POSITION 1
47100		RA=RA+RW
47200	C  POSITION 2
47300		RD=RD+RW
47400	C******************************
47500		RH=RH+RW
47600	98	RSTJ2=RSTJ2*RBM
47700	C  RBM BRINGS LINES OF BEAMS CLOSER TOGETHER. (=.83)
47800	93	IF(JJ2.GT.RX)GO TO 94
47900		IF(J10.GE.10)GO TO 7
48000	C**********************
48100		IF(J8.EQ.0)GO TO 94
48200		R3=RW
48300		IF(J9.EQ.0)GO TO 292
48400	 	IF(J8.GE.20)GO TO 193
48500	293	RX=R3Q-RD
48600		GO TO 194
48700	7	RHX=RH-R3Q
48800		R3=RD-R3Q
48900		GO TO 292
49000	193	RX=RD-RA
49100	194	R3=ABS(RX)
49200	292	DISX=ABS(R3Q-RA)
49300		HGT=RJX-RJY
49400		IF(J10.GE.10)HGT1=HGT*RHX/DISX
49500	C**********************
49600		R3=R3/DISX
49700	195	HGT=HGT*R3
49800	196	L=J8/10
49900		J8=0
50000		IF(J10.GE.10)GO TO 8
50100	C***************
50200		IF(L.EQ.1)GO TO 95
50300	C   BEAM LFT=1,  RT=2   (PARAM 8=10 OR 20)
50400		R3Q=RD
50500		RJX=RJY+HGT
50600		GO TO 94
50700	C**************
50800	8	R3Q=RH
50900		RA=RD
51000		RJY=RJX-HGT
51100		RJX=RJX-HGT1
51200		GO TO 94
51300	95	RA=RD
51400		RJY=RJX-HGT
51500	94	L=7.*RMINI
51600	930	RC=0
51700	C  MINI LINES HAVE .2 SMALLER BEAMS.  MAYBE CHANGE THIS??
51800		CALL LINES(R3Q,RJX,3)
51900		DO 941 K=1,L
52000		CALL BMS
52100		IF(PLT.GE.0)GO TO 940
52200		RC=RC+RY
52300	C FOR THICKENING.
52400		CALL BMS
52500		CALL EXCH(RA,R3Q)
52600	941	CALL EXCH(RJY,RJX)
52700		CALL BMS
52800	C  DRAWS 5 LINES FOR BEAMS.
52900	940	JJ2=JJ2-1
53000		IF(JJ2.LE.0)GO TO 942
53100	C  IF P7=10 OR 20 ONE BEAM WILL APPEAR.
53200		RJY=RJY+RJ
53300		RJX=RJX+RJ
53400		GO TO 930
53500	
53600	942	IF(R8.NE.0)RETURN
53700		IF(R9.EQ.0)RETURN
53800		IF(R10.GE.30)RETURN
53900	C FOR NUMBERS OUTSIDE BEAMS
54000		RSTJ2=RMINI
54100		RD=-10.
54200		IF(R7.LT.20)RD=8.3
54300	943	J3=R3Q+(RA-R3Q)/2.
54400		R6=1.
54500	CC *** DONE IN CENTX ***	R4=AMOD(R4,100.)
54600		R4=R4+(R5-R4)/2.+RD
54700		R7=1
54800	C ITALICS
54900		CALL MAKNUM(R9)
55000		RETURN
55100	
55200	100	RA=0
55300	C  FOR STAFF LINES: 8, POS 1, HGT(3 TO -3), UP-DOWN(NT #S), 
55400	C  P5=SIZE, P6=2ND POS., P7=(1=INVIS.), P8=SPACER, P9=INST. NAME
55500	C  P6=SIZE FACTOR, IF P7≠0 STAFF IS INVIS. 
55600	C  PLT =-2 MAKES HEAVY STAFF.(FOR XGP)
55700		IF(R5.EQ.0)R5=RSTFAC(J2)
55800		CALL NOZERO(R5)
55900		RSTFAC(J2)=R5
56000		RX=(J2+3)*123-369.+R4*7.*R5
56100	CC	RC=R5
56200		STFF(J2)=RX
56300		RX=RX+RTF*R5
56400	C  FOR RTF SEE DATA
56500		RA=RX
56600	C  FOR 2 PASS PLOTTING
56700		RJ=RHORZ(R6)
56800		IF(R6.EQ.0)RJ=596
56900		R5=R5*14.
57000		IF(R8.EQ.0)GO TO 68
57100		IF(PLT)GO TO 68
57200		RZ=RX+R8*167.
57300	C  167 IS A MAGIC NUMBER!!  PUTS LINE ON DPY.
57400		CALL LINX(R3,RZ,RJ,RZ)
57500	C  SHOWS WHERE NEXT STAFF 0 WILL BE.
57600	68	IF(J7.EQ.0)GO TO 101
57700		IF(PLT.EQ.0)CALL LINES(-596.,RX,3)
57800	C  TO ACTIVATE DPY BUFFER
57900		RETURN
58000	101	DO 6 K=1,5
58100		RZ=RJ
58200		RW=R3
58300		IF(K.EQ.2)GO TO 66
58400		IF(K.NE.4)GO TO 67
58500	66	CALL EXCH(RW,RZ)
58600	67	CALL LINX(RZ,RX,RW,RX)
58700	6	RX=RX+R5
58800		IF(RA.EQ.1000)RETURN
58900		IF(PLT.NE.-2)RETURN
59000		RX=RA-1./RHT
59100	CC	R5=RC
59200		RA=1000
59300		GO TO 101
59400		END
59500	
59600	CC	SUBROUTINE BMS
59700	CC	COMMON/STF/RSTFAC(-3/4),RSTJ2/BM/RA,RC,RJY
59800	CC	CALL LINES(RA,RJY+RC*RSTJ2,2)
59900	CC	END
60000	
60100		SUBROUTINE METER
60200	      COMMON R2,JA,CENTR,J2,RJQ(20),J3,JQ(19)/STF/RSTFAC(-3/4),RSTJ2
60300		COMMON/POSI/STFF(-3/4),JJ2,POS
60400		EQUIVALENCE (R4,RJQ(2)),(R7,RJQ(5)),(R6,RJQ(4)),(R5,RJQ(3))
60500		1,(R8,RJQ(6)),(RX3,RJQ(20)),(J10,JQ(7)),(J7,JQ(5)),(R9,RJQ(7))
60600	
60700	C  PARAMS  18 / STF / POS / VERT HGT./ TOP NUM/ BOT NUM/ SIZE FAC.
60800	
60900		CALL NOZERO(R7)
61000		JZ=J3
61100		RY=R4+8.*R7
61200	C  HEIGHT
61300		RW=R6
61400	C  BOTTOM NUM
61500	C  P5=TOP NUM
61600		R6=R7
61700		RR6=R6
61800	C  SIZE
61900	C  FOR BDR40  -- OR =1
62000		M=0
62100		R4=RY
62200	2	R7=0
62300	C  R7=0 FOR BDR FONT??
62400	CC	IF(R5.NE.99)GO TO 1
62500		IF(R5.LT.90)GO TO 3
62600	C  99 AS METER = 'C'  98=ALLA BREVE (CUT TIME)
62700		M=-1
62800		IF(R5.NE.98)GO TO 4
62900	C NEXT FOR LINE THROUGH C.
63000		RZ=R6
63100		RY=R4
63200		RA=POS
63300		R6=RX3
63400	C  TO LINE UP WITH R3
63500		J10=2
63600	C  FOR THICK LINE
63700		R4=4.2
63800		R5=9.8
63900		J7=0
64000		R8=0
64100		CALL ITMSUB
64200		POS=RA
64300		R4=RY
64400		R6=RZ
64500	C GET BACK THE RIGHT PARAMS.
64600	
64700	4	R5=9999.
64800		GO TO 3
64900	C  TO CENTER 12S AND 16S
65000	3	CALL MAKNUM(R5)
65100		IF(M)RETURN
65200	C  STICK AROUND FOR BOTTOM NUM
65300		M=-1
65400		R4=RY-4.*RR6
65500		R6=RR6
65600		R5=RW
65700	C  GET BOTTOM NUM
65800		J3=JZ
65900		R8=0
66000		GO TO 2
66100		END
66200	
66300	CF	SUBROUTINE RNOTE(X)
66400	CF	COMMON /PTR/PWDS(250),ITEM,L,I,IX/XRN/RN(4000)
66500	CF	X=RN(IFIX(PWDS(IFIX(AMOD(X,1000.))))+2)
66600	CF	END
66700	
66800		SUBROUTINE MAKNUM(RNUM)
66900		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/STF/RSTFAC(-3/4),RSTJ2
67000		EQUIVALENCE (J3,JQ(1)),(R4,RJQ(2)),(R8,RJQ(6)),(R7,RJQ(5))
67100	     1,(R6,RJQ(4)),(R5,RJQ(3)),(R7,RJQ(5)),(JQ(15),B),(JQ(16),C)
67200		1 ,(J8,JQ(6)),(J10,JQ(8)),(R3,RJQ(1)),(J5,JQ(3)),(RJY,JQ(19))
67300		1 ,(J7,JQ(5)),(J6,JQ(4)),(R9,RJQ(7))
67400		DATA RS/10.0/,RBX/1.0/
67500		RB8=R8
67600		J3X=J3
67700	C P7=0=BDR40; =1=BDI40; =2=PRIM.
67800		CALL NOZERO(R6)
67900		R5=R6
68000	C  UPPER CASE - BDR40
68100		R6=48000000.0+(R7+50.)*10000.
68200		R7=99999999.0
68300	C  BLANKS
68400		R8=R7
68500		IF(RNUM.NE.9999.)GO TO 2
68600	C  NEXT FOR 'C'OMMON TIME
68700		RNUM=12.
68800	C  MAKES A 'C'
68900		R4=R4-2.2
69000	C  .2 FOR BAD POS. OF LETTERS
69100		GO TO 4
69200	
69300	2	ONE=0 
69400		RNUM=IFIX(RNUM)
69500	C  SO MISTAKES (i.e. 2.2) WON'T BREAK THE PROG.
69600		IF(RNUM.EQ.1.)ONE=3.
69700		IF(RNUM.GT.9.)GO TO 3
69800	C  JUMP FOR 2 OR 3 DIGIT NUMBER
69900	4	R6=R6+RNUM*100.+47.
70000	C  PUTS BLANK ON END (.47)
70100		GO TO 1
70200	
70300	3	RJY=10.
70400		IF(RNUM.GE.100.)RJY=100.
70500		B=IFIX(RNUM/RJY)
70600		C=AMOD(RNUM,RJY)
70700		IF(RNUM.LT.100)GO TO 7
70800		D=IFIX(C/10.)
70900		C=AMOD(C,10.)
71000		IF(C.EQ.1.)ONE=ONE+3.
71100		R7=C*1000000.+999999.0
71200		C=D
71300	7	R6=R6+B*100.+C
71400		IF(B.EQ.1.)ONE=ONE+3.
71500		IF(C.EQ.1.)ONE=ONE+3.
71600		B=R5
71700		IF(RNUM.GE.100.)B=B*2
71800		J3=J3-RS*RSTJ2*B
71900	C  FOR 2 DIGIT NUMBER
72000	CCC	IF(RNUM.GE.20.)GO TO 6
72100	CCC	IF(JA.EQ.18)GO TO 6
72200	CCC	RJY=5.6
72300	CCC	IF(RNUM.GT.11.)RJY=3.
72400	C  ADJUSTS FOR 11, ETC.
72500	CCC	J2=J2+RJY*R5*RSTJ2
72600	CC6	J3=J2
72700	1	J3=J3+ONE*R5*RSTJ2
72800	C CENTERS THE NUMBER '1'
72900		CALL ALPHA
73000		J3=J3X
73100		IF(RB8.EQ.0)RETURN
73200	C NEXT FOR CIRCLES AND BOXES AROUND NUMBERS.
73300		R3=J3-R5
73400		IF(J10.EQ.0)J10=1
73500	C  USE J10 FOR EVEN THICKER BOX AND CIRC.
73600		IF(RNUM.GT.9)R3=R3+R5*RBX
73700	C  TO SET CENTER
73800		IF(RB8.EQ.2)GO TO 5
73900		R4=R4+R5+.1+.05/R5
74000	C  END OF ABOVE IS FOR SMALL CIRCLES.
74100		B=4.5
74200		IF(RNUM.GE.100.)B=5.5
74300		R5=R5*B
74400		JA=12
74500		J6=0
74600		J7=0
74700		J8=J10
74800		CALL CENTX
74900		CALL SLUR
75000		RETURN
75100	
75200	5	JA=4
75300		B=6
75400		R9=0
75500		IF(RNUM.LT.100.)GO TO 8
75600		B=9.
75700		R9=R5*6.
75800	C  MAKES RECTANGLE IF ≥100
75900	8	R4=R4+R5*.7+.1
76000		R8=R5*B
76100		J5=50
76200		CALL ITMSUB
76300	C  RETURNS ORIG. HORIZ. POS.
76400		END
76500	C  MAKES ONLY 1 TO 3 DIGIT NUMS NOW.  EXPAND LATER.
76600	
76700	CC	FUNCTION IABS(N)
76800	C  BECAUSE IABS IN LIB40 HAS A BUG.
76900	CC	IABS=N
77000	CC	IF(N)IABS=-N
77100	CC	END
77200	
77300	CF	SUBROUTINE DRWNT(RMINI)
77400	CF	COMMON /STF/RSTFAC(-3/4),RSTJ2
77500	CF	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
77600	CF	EQUIVALENCE (JE,JQ(3)),(RJD,RJQ(2)),(R6,RJQ(4)),
77700	CF	1 (JG,JQ(5)),(R7,RJQ(5)),(RJE,RJQ(3)),(RJZ,RJQ(20))
77800	CF	1 ,(JI,JQ(7)),(R9,RJQ(7)),(JH,JQ(6))
77900	CF	RJX=CENTR
78000	CF	JH=0
78100	C  JH=0 SO IT WILL FILL. (P8 IN 'CLEFS')
78200	CC	CENTR=CENTR-21.*RSTJ2
78300	CF	RA=R6
78400	CF	R6=.5*RMINI/RSTJ2
78500	CF	R7=R6
78600	CF	RJD=RJZ-3
78700	CCXX	IF(RSTJ2.NE.RMINI)RJD=RJZ+.43*(RJZ-3.)-.3
78800	C  ADJUSTS POSITION FOR MINI ACCIDENTALS (..??!!)
78900	CF	JI=0
79000	CF	CALL CLEFS
79100	CF	JI=R9
79200	C  ↑↑↑↑↑↑ NEEDED??
79300	C  FIX THIS???? ↑↑↑↑↑
79400	C  FOR WHITE NOTES AND ACCIS ON PLOTTER.
79500	CF	CENTR=RJX
79600	CF	R6=RA
79700	CF	R7=JG
79800	CF	JE=RJE
79900	CF	END
80000	
80100	CC	FUNCTION RHORZ(R)
80200	CC	RHORZ=R*5.96-596.
80300	CC	END
80400	
80500	CF	SUBROUTINE RDRAW(I,S,XY,X,R3,CENTR,RMINI)
80600	C   TO X,Y INTO ONE WORD
80700	CF	DIMENSION XY(1)
80800	CF	DO 2 K=I,IFIX(S)
80900	CF	L=2
81000	CF	Y=XY(K)
81100	CF	IF(Y.LT.1000.)GO TO 3
81200	CF	L=3
81300	CF	Y=Y-1000.
81400	C   >1000 = INVIS. LINE
81500	CF3	M=Y
81600	CF	Y=(Y-M)*1000.
81700	CF	IF(Y.GT.100.)Y=100-Y
81800	C   Y NUMBERS .GT.100 ARE NEG.
81900	CF	B=Y*X+CENTR
82000	CF	IF(M.GT.60)M=100-M
82100	CF	A=M*RMINI+R3
82200	CF2	CALL LINES(A,B,L)
82300	CF	END
82400		
82500	CC	FUNCTION EEXP(X,Y)
82600	CC	EEXP=X**Y
82700	CC	END